home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL Networking / Network / ADSP.lisp next >
Encoding:
Text File  |  1990-08-31  |  24.0 KB  |  567 lines  |  [TEXT/CCL ]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; Copyright 1987, 1988, 1989, 1990 by Ruben Kleiman for Apple Computer, Inc.
  3. ;;; Advanced Technology Group
  4. ;;;
  5.  
  6. ;;; ADSP AppleTalk protocol Server Subsystem
  7.  
  8. ;;; INSTRUCTIONS:
  9. ;;;
  10. ;;; Consult SAMPLE-SESSION.TXT file for an example of how to use
  11. ;;; the system at the highest level (assumes use of SERVER and EVENTS).
  12. ;;;
  13.  
  14. (in-package :network :use '(ccl system lisp))
  15.  
  16.  
  17. ;;; Are we monitoring network events?
  18. ;;;
  19. (defvar *monitoring* t)
  20.  
  21. (eval-when (load eval compile)
  22.   (require :traps)
  23.   (require :network-defs)          ; needed record definitions (don't compile them!)
  24.   (require :driver)                ; the generic driver objects
  25.   (require :NBP)                   ; this code handles the NBP protocol objects
  26.   (require :server))               ; the generic server objects
  27.  
  28.  
  29. ;;; The ADSP Server uses these three types of objects:
  30. ;;;  1) *nbp-driver* ::= this is used for socket registration on the AppleTalk network--defined in NBP.Lisp
  31. ;;;  2) *adsp-stream* ::= used to write and read to/from a remote ADSP client or server
  32. ;;;  3) *adsp-server* ::= used by server node to listen for requests from remote ADSP clients
  33.  
  34. ;;; You can perform any of the Common Lisp stream io calls on *adsp-stream*
  35. ;;; (currently, only string-tyo and string-tyi are supported).
  36.  
  37. ;;; You use a *adsp-server* object if you develop a server which you want
  38. ;;; remote clients to access.  This server can listen for connection requests from remote clients.
  39. ;;; Using turn-server-on and turn-server-off, however, you need never be aware of these objects
  40. ;;; (see generic-server.lisp).
  41.  
  42. ;;; The *nbp-driver* and *adsp-driver* object instances are transparent to you.  They are
  43. ;;; responsible for running the Macintosh .NBP & .DSP drivers.
  44.  
  45.  
  46. (defun report-adsp-error (ioResult)
  47.   (or (= ioResult 0)   ; Completed without error
  48.       (= ioResult 1)   ; Call did not complete (yet)
  49.       (format t
  50.               (case ioResult
  51.                 (-1280 "~%ADSP Bad connection refNum (~a)")
  52.                 (-1279 "~%ADSP Control call was aborted (~a)")
  53.                 (-1278 "~%ADSP Bad connection state for this operation (~a)")
  54.                 (-1277 "~%ADSP Open connection request failed or denied (~a)")
  55.                 (-1276 "~%ADSP Attention message data too long (~a)")
  56.                 (-1275 "~%ADSP Read terminated by forward reset (~a)")
  57.                 (OTHERWISE "~%ADSP Unknown error (~a)"))
  58.               ioResult)))
  59.  
  60. ;;; -------------------------------------------------------------------------------------------
  61. ;;; ADSP Driver Definitions
  62.  
  63. (defobject *adsp-driver* *driver*)
  64.  
  65. (defvar *the-adsp-driver* nil)
  66.  
  67. (defun check-adsp-driver ()
  68.   (or *the-adsp-driver*
  69.       (setq *the-adsp-driver* (oneOf *adsp-driver* :driver-name ".DSP")))
  70.   (or (ask *the-adsp-driver* driver-open-p)
  71.       (ask *the-adsp-driver* (stream-open))))
  72.  
  73. (defun adsp-driver-refNum ()
  74.   (if (and *the-adsp-driver*
  75.            (ask *the-adsp-driver* driver-open-p))
  76.     (%get-word (ask *the-adsp-driver* driver-pb) $ioRefNum)
  77.     (error "ADSP driver not open!")))
  78.  
  79. (defun init-adsp ()
  80.   (allow-local-loopback)
  81.   (check-adsp-driver))
  82.  
  83. ;;; -------------------------------------------------------------------------------------------
  84. ;;; *ADSP-STREAM* DEFINITIONS
  85.  
  86. ;;; Allows us to recognize *adsp-stream* as a *stream*, although most (if not all)
  87. ;;; of the default stream methods are overriden here...
  88. (defobject *adsp-stream* *stream*)
  89.  
  90. (defobfun (exist *adsp-stream*) (init-list)
  91.   (usual-exist init-list)
  92.   ;; some of the following are redundant, but worth keeping here until thoroughly debugged...
  93.   (have 'input-buffer nil)
  94.   (have 'input-count 0)
  95.   (have 'next-input 0)
  96.   (have 'output-buffer nil)
  97.   (have 'output-count 0)
  98.   (have 'service-name (getf init-list :service-name "unknown"))
  99.   (have 'service-type (getf init-list :service-type "unknown"))
  100.   (have 'stream-open-p nil)
  101.   (have 'DriverRefNum nil)
  102.   (have 'localSocket nil)
  103.   (have 'ConnRefNum nil)
  104.   (have 'driver-pb (_NewPtr :errchk :d0 $dspPBSize :a0)) ; the driver control block
  105.   (have 'ccbPtr (make-record :TRCCB)))                   ; the ADSP connection control block
  106.  
  107. (defobfun (driver-control *adsp-stream*) (code)
  108.   "Handles driver control traps for ADSP streams"
  109.   ;; The driver must be open!
  110.   (%put-word driver-pb code $csCode)
  111.   (_Control :a0 driver-pb))
  112.  
  113. (defobfun (stream-open *adsp-stream*) (&optional remoteName remoteType &key (request-connection t))
  114.   "Create, initialize, and open a connection end"
  115.   (declare (object-variable DriverRefNum LOCALSOCKET CONNREFNUM SERVICE-NAME
  116.                             SERVICE-TYPE STREAM-OPEN-P))
  117.   (setq DriverRefNum (adsp-driver-refNum))
  118.   (initialize)    ; Initialize queues and connection
  119.   (setq LocalSocket (rref driver-pb DSPParamBlock.localSocket))
  120.   (setq ConnRefNum (rref driver-pb DSPParamBlock.ccbRefNum))
  121.   (setq service-name remoteName)
  122.   (setq service-type remoteType)
  123.   
  124.   (and request-connection
  125.        (request-connection remoteName remoteType))             ; connect to remote node
  126.   
  127.   (setq stream-open-p t)
  128.   (and *monitoring* (format t "~%adsp stream opened on ~a" (self))))
  129.  
  130. (defobfun (initialize *adsp-stream*) (&optional (qSize $StdQSize))
  131.   "Initializes an ADSP stream object"
  132.   (declare (object-variable DRIVERREFNUM CCBPTR))
  133.   (check-adsp-driver)
  134.   (rset driver-pb DSPParamBlock.ioVRefNum  DriverRefNum)
  135.   (rset driver-pb DSPParamBlock.ioCRefNum  DriverRefNum)
  136.   (rset driver-pb DSPParamBlock.ccbPtr ccbPtr)
  137.   (rset driver-pb DSPParamBlock.userRoutine nil)
  138.   (rset driver-pb DSPParamBlock.sendQSize qSize)
  139.   (rset driver-pb DSPParamBlock.sendQueue (_NewPtr :errchk :d0 qSize :a0))
  140.   (rset driver-pb DSPParamBlock.recvQSize qSize)
  141.   (rset driver-pb DSPParamBlock.recvQueue (_NewPtr :errchk :d0 qSize :a0))
  142.   (rset driver-pb DSPParamBlock.attnPtr (_NewPtr :errchk :d0 $attnBufSize :a0))
  143.   (rset driver-pb DSPParamBlock.remoteAddress 0)
  144.   (rset driver-pb DSPParamBlock.localSocket 0)
  145.   (driver-control $dspInit)
  146.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  147.   (and *monitoring* (format t "~%adsp stream initialized on ~a" (self))))
  148.  
  149. (defobfun (request-connection *adsp-stream*) (remoteName remoteType)
  150.   (declare (object-variable DRIVERREFNUM CONNREFNUM))
  151.   (check-adsp-driver)
  152.  
  153.   ;; Get internet address of remote node socket
  154.   (multiple-value-bind (succeeded remoteAddress)
  155.                        (NBP-lookup remoteName remoteType)
  156.     (if (not succeeded)
  157.       (error "Could not find ~a server ~a" remoteName remoteType))
  158.  
  159.   ;; Request connection with remote node socket
  160.   (rset driver-pb DSPParamBlock.csCode $dspOpen)
  161.   (rset driver-pb DSPParamBlock.ioVRefNum DriverRefNum)
  162.   (rset driver-pb DSPParamBlock.ioCRefNum DriverRefNum)
  163.   (rset driver-pb DSPParamBlock.ccbRefNum ConnRefNum)
  164.   (rset driver-pb DSPParamBlock.filterAddress 0)
  165.   (rset driver-pb DSPParamBlock.ocMode $ocRequest)
  166.   (rset driver-pb DSPParamBlock.ocInterval 50)
  167.   (rset driver-pb DSPParamBlock.ocMaximum 20)
  168.   (%put-full-long driver-pb  remoteAddress 38)
  169.   (_AControl :errchk :a0 driver-pb)               ; asynch control call
  170.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  171.   (and *monitoring* (format t "~%adsp stream connection requested on ~a" (self)))))
  172.  
  173. (defobfun (stream-close *adsp-stream*) ()
  174.   "Closes the ADSP stream"
  175.   (declare (object-variable CCBPTR STREAM-OPEN-P))
  176.   (check-adsp-driver)
  177.   
  178.   (remove-connection)
  179.   
  180.   ;; Get rid of any allocated Mac heap storage
  181.   (when (zone-pointerp (rref driver-pb DSPParamBlock.sendQueue))
  182.     (_DisposPtr :errchk :a0 (rref driver-pb DSPParamBlock.sendQueue))
  183.     (rset driver-pb DSPParamBlock.sendQueue 0))
  184.   (when (zone-pointerp (rref driver-pb DSPParamBlock.recvQueue))
  185.     (_DisposPtr :errchk :a0 (rref driver-pb DSPParamBlock.recvQueue))
  186.     (rset driver-pb DSPParamBlock.recvQueue 0))
  187.   (when (zone-pointerp (rref driver-pb DSPParamBlock.attnPtr))
  188.     (_DisposPtr :errchk :a0 (rref driver-pb DSPParamBlock.attnPtr))
  189.     (rset driver-pb DSPParamBlock.attnPtr 0))
  190.   (when (zone-pointerp ccbPtr)
  191.     (dispose-record ccbPtr)
  192.     (setq ccbPtr nil))
  193.   (when (zone-pointerp (rref driver-pb DSPParamBlock.remoteAddress))
  194.     (_DisposPtr :errchk :a0 (rref driver-pb DSPParamBlock.remoteAddress))
  195.     (rset driver-pb DSPParamBlock.remoteAddress 0))
  196.   (when (zone-pointerp (rref driver-pb DSPParamBlock.filterAddress))
  197.     (_DisposPtr :errchk :a0 (rref driver-pb DSPParamBlock.filterAddress))
  198.     (rset driver-pb DSPParamBlock.filterAddress 0))
  199.   (when (zone-pointerp driver-pb)
  200.     (_DisposPtr :errchk :a0 driver-pb)
  201.     (setq driver-pb nil))
  202.   (setq stream-open-p nil)
  203.   (and *monitoring* (format t "~%adsp stream closed on ~a" (self))))
  204.  
  205. (defobfun (remove-connection *adsp-stream*) (&optional abort-p)
  206.   "Unallocate ADSP stream io queues and terminate adsp connection"
  207.   (declare (object-variable DRIVERREFNUM CONNREFNUM))
  208.   (check-adsp-driver)
  209.   (rset driver-pb DSPParamBlock.ioCRefNum DriverRefNum)
  210.   (rset driver-pb DSPParamBlock.ccbRefNum ConnRefNum)
  211.   (rset driver-pb DSPParamBlock.abort (or abort-p 0))
  212.   (driver-control $dspRemove)
  213.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  214.   (and *monitoring* (format t "~%adsp stream connection removed on ~a" (Self))))
  215.  
  216. (defobfun (accept-connection *adsp-stream*)
  217.           (remoteCID remoteAddress sendSeq sendWindow attnSendSeq)
  218.   (declare (object-variable DRIVERREFNUM CONNREFNUM))
  219.   (check-adsp-driver)
  220.   (rset driver-pb DSPParamBlock.ioCRefNum DriverRefNum)
  221.   (rset driver-pb DSPParamBlock.ccbRefNum ConnRefNum)
  222.   (rset driver-pb DSPParamBlock.remoteCID remoteCID)
  223.   (rset driver-pb DSPParamBlock.sendSeq sendSeq)
  224.   (rset driver-pb DSPParamBlock.sendWindow sendWindow)
  225.   (rset driver-pb DSPParamBlock.attnSendSeq attnSendSeq)
  226.   (rset driver-pb DSPParamBlock.filterAddress 0)
  227.   (rset driver-pb DSPParamBlock.ocMode $ocAccept)
  228.   (rset driver-pb DSPParamBlock.ocInterval 50)
  229.   (rset driver-pb DSPParamBlock.ocMaximum 20)
  230.   (%put-full-long driver-pb remoteAddress 38)
  231.   (driver-control $dspOpen)
  232.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  233.   (and *monitoring* (format t "~%adsp stream connection accepted on ~a" (self)))
  234.   (self))   ; must return SELF
  235.  
  236. (defobfun (status *adsp-stream*) ()
  237.   (declare (object-variable DRIVERREFNUM CONNREFNUM))
  238.   (rset driver-pb :DSPParamBlock.ioCRefNum DriverRefNum)
  239.   (rset driver-pb :DSPParamBlock.ccbRefNum ConnRefNum)
  240.   (driver-control $dspStatus)
  241.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  242.   (values (nth (1- (rref (rref driver-pb DSPParamBlock.statusCCB) TRCCB.state))
  243.                '(listening passive opening open closing closed))
  244.           (rref driver-pb DSPParamBlock.sendQPending)
  245.           (rref driver-pb DSPParamBlock.sendQFree)
  246.           (rref driver-pb DSPParamBlock.recvQPending)
  247.           (rref driver-pb DSPParamBlock.recvQFree)))
  248.  
  249. (defobfun (stream-eofp *adsp-stream*) ()
  250.   (not (stream-listen)))
  251.  
  252. (defobfun (stream-listen *adsp-stream*) ()
  253.   (declare (object-variable next-input input-count))
  254.   (or (< next-input input-count)
  255.       (multiple-value-bind (state send-count send-free received-count receive-free)
  256.                            (status)
  257.         (declare (ignore receive-free send-free send-count state))
  258.         (> received-count 0))))
  259.  
  260. (defobfun (stream-tyi *adsp-stream*) ()
  261.   (declare (object-variable NEXT-INPUT INPUT-COUNT INPUT-BUFFER))
  262.   (cond ((< next-input input-count)
  263.          (aref input-buffer (1- (incf next-input))))  ; maybe copy?
  264.         (t (string-receive)
  265.            (stream-tyi))))
  266.  
  267. (defobfun (stream-tyo *adsp-stream*) (char)
  268.   (declare (object-variable OUTPUT-BUFFER OUTPUT-COUNT))
  269.   (setq output-buffer
  270.         (concatenate 'simple-string
  271.                      output-buffer
  272.                      (string char)))
  273.   (if (> (incf output-count) 255)   ; incf is messed
  274.     (stream-force-output)))
  275.  
  276. (defobfun (stream-force-output *adsp-stream*) ()
  277.   (declare (object-variable OUTPUT-BUFFER DRIVERREFNUM CONNREFNUM OUTPUT-COUNT))
  278.   (with-pstrs ((data output-buffer))  ; temporary ptr should work because I'm sending immediate (I hope)
  279.     (rset driver-pb DSPParamBlock.ioCRefNum DriverRefNum)
  280.     (rset driver-pb DSPParamBlock.ccbRefNum ConnRefNum)
  281.     (rset driver-pb DSPParamBlock.reqCount output-count)
  282.     (rset driver-pb DSPParamBlock.dataPtr (ccl::%inc-ptr data 1))  ; jump over Pascal string header
  283.     (rset driver-pb DSPParamBlock.eom 1)
  284.     (rset driver-pb DSPParamBlock.flush 1)
  285.     (driver-control $dspWrite))
  286.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  287.   (setq output-count 0)
  288.   (setq output-buffer "")
  289.   (- (rref driver-pb DSPParamBlock.actCount) 1))
  290.  
  291. (defobfun (stream-fresh-line *adsp-stream*) ()
  292.   (stream-tyo #\NewLine))
  293.  
  294. (defobfun (stream-untyi *adsp-stream*) (char)
  295.   (declare (object-variable INPUT-COUNT INPUT-BUFFER))
  296.   (incf input-count)
  297.   (setq input-buffer
  298.         (concatenate 'simple-string (string char) input-buffer))
  299.   char)
  300.  
  301. (defobfun (stream-clear-input *adsp-stream*) ()
  302.   (declare (object-variable INPUT-BUFFER))
  303.   (setq input-buffer nil))
  304.  
  305. (defobfun (stream-abort *adsp-stream*) ()
  306.   (stream-close))
  307.  
  308. (defobfun (string-receive *adsp-stream*) ()
  309.   (declare (object-variable NEXT-INPUT INPUT-COUNT INPUT-BUFFER))
  310.   (do ((string-read (coerce (get-adsp-string) 'simple-string)
  311.                     (concatenate 'simple-string string-read (get-adsp-string))))
  312.       ((or  (= 1 (rref driver-pb DSPParamBlock.eom))
  313.             (stream-eofp))
  314.        (setq next-input 0)
  315.        (setq input-count (length string-read))
  316.        (setq input-buffer string-read))))
  317.  
  318. (defobfun (get-adsp-string *adsp-stream*) ()
  319.   (declare (object-variable DRIVERREFNUM CONNREFNUM))
  320.   (if (stream-eofp)
  321.     ""
  322.     (%stack-block ((dataPtr $StdQSize))
  323.       (rset driver-pb DSPParamBlock.ioCRefNum DriverRefNum)
  324.       (rset driver-pb DSPParamBlock.ccbRefNum ConnRefNum)
  325.       (rset driver-pb DSPParamBlock.reqCount $StdQSize)
  326.       (rset driver-pb DSPParamBlock.dataPtr dataPtr)
  327.       (driver-control $dspRead)
  328.       (report-adsp-error (%get-signed-word driver-pb $ioResult))
  329.       (ccl::%str-from-ptr (rref driver-pb DSPParamBlock.dataPtr)
  330.                           (rref driver-pb DSPParamBlock.actCount)))))
  331.  
  332. (defobfun (string-read-immediate *adsp-stream*) ()
  333.   (do ((string-read (coerce (get-adsp-string) 'simple-string)
  334.                     (concatenate 'simple-string string-read (get-adsp-string))))
  335.       ((or  (= 1 (rref driver-pb DSPParamBlock.eom))
  336.             (stream-eofp))
  337.        string-read)))
  338.  
  339. ;;; -------------------------------------------------------------------------------------------
  340. ;;; *adsp-server* DEFINITIONS
  341.  
  342. ;;; The adsp server is initiated through a stream-open.  The server can be activated and deactivated
  343. ;;; by sending it a server-on and server-off message, respectively.  The server can
  344. ;;; be disposed through the remove-server message.
  345.  
  346. (defobject *adsp-server* *adsp-stream* *server*)
  347.  
  348. (defobfun (stream-open *adsp-server*) ()
  349.   "Open and initialize the ADSP server"
  350.   (declare (object-variable STREAM-OPEN-P DRIVERREFNUM))
  351.   (setq stream-open-p t)
  352.   (setq DriverRefNum (adsp-driver-refNum))
  353.   (initialize)
  354.   (and *monitoring* (format t "~%adsp server stream opened on ~a" (self))))
  355.  
  356. (defobfun (initialize *adsp-server*) ()
  357.   "Create and initialize an ADSP stream--without send-rcv-attn buffers!"
  358.   (declare (object-variable DRIVERREFNUM CCBPTR LOCALSOCKET CONNREFNUM))
  359.   (check-adsp-driver)
  360.   (rset driver-pb DSPParamBlock.ioVRefNum DriverRefNum)
  361.   (rset driver-pb DSPParamBlock.ioCRefNum DriverRefNum)
  362.   (rset driver-pb DSPParamBlock.ccbPtr ccbPtr)
  363.   (rset driver-pb DSPParamBlock.userRoutine nil)
  364.   (rset driver-pb DSPParamBlock.localSocket 0)
  365.   (driver-control $dspCLInit)
  366.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  367.   (setq localSocket (rref driver-pb DSPParamBlock.localSocket))
  368.   (setq ConnRefNum (rref driver-pb DSPParamBlock.ccbRefNum))
  369.   (and *monitoring* (format t "~%adsp server initialized on ~a" (self))))
  370.  
  371.  
  372. (defobfun (remove-connection *adsp-server*) (&optional abort-p)
  373.   "Terminate and dispose of ADSP server"
  374.   (declare (object-variable DRIVERREFNUM CONNREFNUM))
  375.   (check-adsp-driver)
  376.   (rset driver-pb DSPParamBlock.ioCRefNum  DriverRefNum)
  377.   (rset driver-pb DSPParamBlock.ccbRefNum ConnRefNum)
  378.   (rset driver-pb DSPParamBlock.abort (or abort-p 0))
  379.   (driver-control $dspCLRemove)
  380.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  381.   (and *monitoring* (format t "~%adsp server connection removed on ~a" (self))))
  382.  
  383. (defobfun (server-on *adsp-server*) ()
  384.   "Register server & listen for remote requests"
  385.   (declare (object-variable NAME TYPE LOCALSOCKET REGISTERED-P))
  386.   (check-adsp-driver)
  387.   (NBP-register name type localSocket)
  388.   (setq registered-p t)
  389.   (server-listen))
  390.  
  391. (defobfun (server-listen *adsp-server*) ()
  392.   "Listen for a remote request"
  393.   (rset driver-pb DSPParamBlock.filterAddress 0)
  394.   (rset driver-pb DSPParamBlock.localCID 0)
  395.   (rset driver-pb DSPParamBlock.remoteCID 0)
  396.   (%put-word driver-pb $dspCLListen $csCode)
  397.   (_AControl :errchk :a0 driver-pb)               ; asynch control call
  398.   (report-adsp-error (%get-signed-word driver-pb $ioResult)))
  399.  
  400. (defobfun (server-off *adsp-server*) ()
  401.   (declare (object-variable NAME TYPE REGISTERED-P))
  402.   "Unregister server & stop listening for remote requests"
  403.   (NBP-unregister name type)
  404.   (setq registered-p nil)
  405.   (stream-close))
  406.  
  407. (pushnew (list :adsp *adsp-server*) *supported-server-media*)
  408.  
  409. ;;; If we have a successful completion, then create a client stream, accept the request,
  410. ;;; and queue the stream on *new-clients*
  411. ;;; Accept client code is going to be a bit slow, so it might require
  412. ;;; "long" waits for other requestors: if it becomes a problem, either
  413. ;;; (1) the code may be queued for higher level execution, or
  414. ;;; (2) an all-purpose accept-communication *adsp-stream* object may be
  415. ;;;     kept around just for accepting connections, deferring creation of
  416. ;;;     the new-client stream to higher level code
  417.  
  418. ;;; Since (eval-when (load) ...) does not work per CL at this time,
  419. ;;; the adsp medium is defined at load time by evaluating (service-form):
  420.  
  421. (defun service-form ()
  422.   '(define-server-medium :ADSP
  423.      (ON-CLIENT-REQUEST
  424.       (cond (deny-connection!            ; deny connection and listen for other requests
  425.              (deny-connection))
  426.             (t   ;; create a client stream and accept communications for it
  427.              (let ((new-client (oneOf *adsp-stream*))
  428.                    (remoteCID (rref driver-pb DSPParamBlock.remoteCID))
  429.                    (remoteAddress (rref driver-pb DSPParamBlock.remoteAddress))
  430.                    (sendSeq (rref driver-pb DSPParamBlock.sendSeq))
  431.                    (sendWindow (rref driver-pb DSPParamBlock.sendWindow))
  432.                    (attnSendSeq (rref driver-pb DSPParamBlock.attnSendSeq))
  433.                    (the-name name)   ; lexically bind name & type
  434.                    (the-type type))
  435.                (ask new-client
  436.                  (stream-open the-name the-type :request-connection nil))
  437.                (and *monitoring* (format t "~%About to accept conn"))    ; SHOULD GET RID OF THIS!!!
  438.                (ask new-client
  439.                  (accept-connection remoteCID remoteAddress sendSeq sendWindow attnSendSeq))
  440.                new-client))))
  441.      (ON-SERVER-ERROR (error-code)
  442.                       (cerror "RESET ~a SERVER ~a & CONTINUE ..." "~a server ~a error ~a" type name error-code))))
  443.  
  444. (eval (service-form))
  445.  
  446. (defobfun (deny-connection *adsp-server*) ()
  447.   (check-adsp-driver)
  448.   (driver-control $dspCLDeny)
  449.   (report-adsp-error (%get-signed-word driver-pb $ioResult))
  450.   (and *monitoring* (format t "~%adsp server connection denied on ~a" (self)))
  451.   NIL)   ; must return NIL
  452.  
  453. (defun initDrivers ()
  454.   (check-nbp-driver)        ; force load .NBP
  455.   (check-adsp-driver)       ; force load .DSP
  456.   (allow-local-loopback))   ; allow server & client to coexist in machine
  457.  
  458.  
  459. (push :adsp *features*)
  460.  
  461. #|
  462.  
  463. ;;; -----------------------------------------------------------------------------------------------
  464. ;;; AN EXAMPLE
  465. ;;; -----------------------------------------------------------------------------------------------
  466.  
  467. ;;; INSTRUCTIONS:
  468.  
  469. ;;; Execute ADSP-SERVER-EXAMPLE on one machine and then ADSP-CLIENT-EXAMPLE on another.
  470. ;;; Both machines must be connected through AppleTalk cable and the ADSP init must be
  471. ;;; inside the System Folder.  Also, you should make sure that the CHOOSER shows
  472. ;;; that AppleTalk is active (if not, select it to be so).
  473.  
  474. ;;; To load the ADSP protocol functions, just (require :ADSP)
  475.  
  476. ;;; Now evaluate the ADSP-SERVER-EXAMPLE and ADSP-CLIENT-EXAMPLE functions in each
  477. ;;; machine, respectively.  Then first evaluate ADSP-SERVER-EXAMPLE in Machine #1
  478. ;;; and then evaluate ADSP-CLIENT-EXAMPLE in Machine #2.  Modify the code to do
  479. ;;; other sorts of things.  For example, if you remove the
  480. ;;; turn-server-off instruction in ADSP-SERVER-EXAMPLE (Machine #1) you'll be able
  481. ;;; to evaluate ADSP-CLIENT-EXAMPLE more than once on Machine #2.
  482.  
  483. ;;; WHAT THE EXAMPLE CODE DOES:
  484.  
  485. ;;; A server in one machine listens for requests from any network node to print a string
  486. ;;; on the server's listener window.  It includes the code for the client node that
  487. ;;; would send such a request.  (Note: the client and server could be in the same node.)
  488.  
  489.  
  490.  
  491. ;;; CODE FOR MACHINE #1 (THE SERVER PART):
  492.  
  493. ;;; This server reads a message from clients and prints it on the local listener
  494. (defun ADSP-SERVER-EXAMPLE (&aux my-server-name my-server-type my-new-client)
  495.   
  496.   (setq my-server-name "a good listener window")
  497.   (setq my-server-type "window printer")
  498.   
  499.   (server::turn-server-on :ADSP :name my-server-name :type my-server-type)     ; you turn the server on
  500.   (format t "~%SERVER> server turned on...")
  501.   
  502.   ;; THE SERVER LISTENER IS TURNED ON:  IT MEANS THAT THE SERVER'S LISTENER IS LISTENING 
  503.   ;; IN THE BACKGROUND FOR REQUESTS FROM "CLIENTS" TO CONNECT TO IT AND USE ITS SERVICES.
  504.   ;; THE CLIENT MAY BE ANYWHERE IN THE NETWORK (INCLUDING IN THE SAME MACHINE).
  505.   ;; WHEN THE SERVER LISTENER HEARS A REQUEST, IT CREATES A STREAM WHICH IS DIRECTLY CONNECTED
  506.   ;; TO THE CLIENT SO THAT YOU MAY TALK TO THE CLIENT THROUGH IT.  YOU PICK UP THE STREAM
  507.   ;; USING THE GET-NEW-CLIENT CALL.  IF THE CLIENT RETURNS NOTHING, THEN NO ONE CALLED YOU (TOO BAD).
  508.   ;; OF COURSE, YOU WILL NOT NORMALLY LOOP LIKE THIS TO WAIT FOR A REQUEST... YOU
  509.   ;; PRESUMABLY HAVE OTHER THINGS TO DO.  (A FUTURE VERSION WILL ALLOW YOU TO WRITE THE
  510.   ;; CODE THAT HANDLES REQUESTS FOR YOU WHEN A NEW CLIENT SHOWS UP WITHOUT YOUR
  511.   ;; HAVING TO ACTIVELY LOOK FOR CLIENTS YOURSELF.)
  512.  
  513.   (format t "~%SERVER> waiting for client requests ...")
  514.   (loop
  515.     (format t ".")
  516.     (setq my-new-client (server::get-new-client my-server-name my-server-type))
  517.     (when my-new-client
  518.       (return nil))
  519.     )
  520.   (format t "~%SERVER> ADSP server found a client...")
  521.  
  522.   (server::turn-server-off :ADSP my-server-name my-server-type)
  523.   (format t "~%SERVER> ADSP server turned off...")
  524.   
  525.   ;; NOW YOU READ A STRING FROM YOUR CLIENT AND PRINT IT ON YOUR LISTENER WINDOW!
  526.   (format t "~%~%SERVER>>>>>>>  ~a~%~%" (ask my-new-client (string-tyi)))
  527.   
  528.   (ask my-new-client (stream-close))
  529.   (format t "~%SERVER> ADSP stream removed..."))
  530.  
  531.  
  532.  
  533. CODE FOR MACHINE #2 (THE CLIENT PART):
  534.  
  535. ;;; This is an example of an ADSP client that will look in the network for an ADSP server
  536. ;;; called "my listener window" of type "window printer".  The latter will accept a
  537. ;;; string from a client and will print it on the server's lisp listener window.
  538.  
  539. ;;; The client just opens a stream to that server, sends a string to it, and closes the stream.
  540. (defun ADSP-CLIENT-EXAMPLE (&aux my-server-stream the-server-name the-server-type)
  541.   "Example of an ADSP client"
  542.  
  543.   ;; THERE'S NOW A BETTER WAY OF DOING THIS USING SERVER::TURN-CLIENT-ON
  544.   ;; AND SERVER::TURN-CLIENT-OFF.  CHECK THOSE FUNCTIONS!
  545.  
  546.   (setq the-server-name "a good listener window")
  547.   (setq the-server-type "window printer")
  548.  
  549.   ;; CREATE AN ADSP STREAM OBJECT WITH WHICH TO TALK TO THE SERVER
  550.   (setq my-server-stream (oneOf *adsp-stream* ))
  551.   (format t "~%CLIENT> an ADSP stream created...")
  552.  
  553.   ;; OPEN YOUR STREAM
  554.   (ask my-server-stream (stream-open the-server-name the-server-type))
  555.   (format t "~%CLIENT> an ADSP stream opened...")
  556.   
  557.   ;; SEND A STRING TO THE SERVER
  558.   (ask my-server-stream (string-out "Hi there nice remote listener window!"))
  559.   (format t "~%CLIENT> send Hi There message to LISTENER LISP server...")
  560.  
  561.   ;; CLOSE YOUR STREAM WHEN YOU ARE DONE WRITING TO THE SERVER
  562.   (ask my-server-stream (stream-close))
  563.   (format t "~%CLIENT> closed stream connection..."))
  564.     
  565. |#
  566.  
  567. (provide :adsp)